#!/usr/bin/perl -w

#=======================================================================
# datefn
# File ID: 4bec96e4-cc13-11de-a8a7-93dd800a3f5e
# Insert timestamp into file names
#
# Character set: UTF-8
# ©opyleft 2009– Øyvind A. Holm <sunny@sunbase.org>
# License: GNU General Public License version 2 or later, see end of 
# file for legal stuff.
#=======================================================================

use strict;
use Getopt::Long;
use File::Basename;
use Time::Local;

$| = 1;

our $Debug = 0;

our %Opt = (

    'bwf' => 0,
    'debug' => 0,
    'delete' => 0,
    'dry-run' => 0,
    'force' => 0,
    'git' => 0,
    'help' => 0,
    'replace' => 0,
    'skew' => 0,
    'verbose' => 0,
    'version' => 0,

);

our $progname = $0;
$progname =~ s/^.*\/(.*?)$/$1/;
our $VERSION = "0.00";

Getopt::Long::Configure("bundling");
GetOptions(

    "bwf" => \$Opt{'bwf'},
    "debug" => \$Opt{'debug'},
    "delete|d" => \$Opt{'delete'},
    "dry-run|n" => \$Opt{'dry-run'},
    "force|f" => \$Opt{'force'},
    "git|g" => \$Opt{'git'},
    "help|h" => \$Opt{'help'},
    "replace|r" => \$Opt{'replace'},
    "skew|s=i" => \$Opt{'skew'},
    "verbose|v+" => \$Opt{'verbose'},
    "version" => \$Opt{'version'},

) || die("$progname: Option error. Use -h for help.\n");

$Opt{'debug'} && ($Debug = 1);
if ($Opt{'delete'} && $Opt{'replace'}) {
    warn("$progname: Cannot mix -d/--delete and -r/--replace options\n");
    exit(1);
}
$Opt{'help'} && usage(0);
if ($Opt{'version'}) {
    print_version();
    exit(0);
}

defined($ARGV[0]) || die("$progname: Missing filenames. Use -h for help.\n");

my $d = '[\dX]'; # Legal regexp digits, 0-9 or X (unknown)
my $r_date = "[12]$d$d$d" . # year
            "$d$d" .        # month
            "$d$d" .        # day
            "T" .
            "$d$d" .        # hours
            "$d$d" .        # minutes
            "$d$d" .        # seconds
            "Z";

for my $Curr (@ARGV) {
    D("Curr = '$Curr'\n");
    process_file($Curr);
}

sub process_file {
    # {{{
    my $File = shift;
    unless (-f $File) {
        warn("$progname: $File: Not a regular file\n");
        return;
    }
    if (!$Opt{'delete'} && !$Opt{'replace'} && numdates($File) > 0) {
        warn("$progname: $File: Filename already has date\n");
        return;
    }
    D(sprintf("mod_date(%s) = '%s'\n", $File, mod_date($File)));
    my $new_name = '';
    my $mod_date = mod_date($File);
    my $start_date = start_date($File);
    my $dates = sprintf("%s%s%s", sec_to_string($start_date), length($start_date) ? "-" : "", sec_to_string($mod_date));
    if (length($dates)) {
        my ($basename, $dirname) = fileparse($File);
        my $new_name = $basename;
        if ($Opt{'replace'}) {
            $new_name = strip_date_from_filename($new_name);
        }
        if ($Opt{'delete'}) {
            $new_name = strip_date_from_filename($new_name);
        } else {
            $new_name = "$dates.$new_name";
        }
        $dirname eq "./" && ($dirname = '');
        $new_name = "$dirname$new_name";
        if ($new_name eq "$File") {
            msg(1, "Filename for $File is unchanged");
            return;
        }
        if ($Opt{'dry-run'}) {
            print("$progname: '$File' would be renamed to '$new_name'\n");
        } else {
            if (-e $new_name && !$Opt{'force'}) {
                warn("$progname: $new_name: File already exists, use --force to overwrite\n");
            } elsif (rename_file($File, $new_name)) {
                print("$progname: '$File' renamed to '$new_name'\n");
            } else {
                warn("$progname: $File: Cannot rename file to '$new_name': $!\n");
            }
        }
    }
    # }}}
} # process_file()

sub rename_file {
    # {{{
    my ($oldname, $newname) = @_;
    my $retval;

    if ($Opt{'git'}) {
        $retval = mysystem('git', 'mv', $oldname, $newname);
        $retval = !$retval;
    } else {
        $retval = rename($oldname, $newname);
    }

    return($retval);
    # }}}
} # rename_file()

sub mysystem {
    # {{{
    my @cmd = @_;
    my $retval;

    msg(0, "Executing \"" . join(' ', @cmd) . "\"...");
    $retval = system(@cmd);

    return($retval);
    # }}}
} # mysystem()

sub mod_date {
    # Return file modification timestamp {{{
    my $File = shift;
    my $Retval = "";
    my @stat_array = stat($File);
    if (scalar(@stat_array)) {
        $Retval = $stat_array[9] + $Opt{'skew'};
    } else {
        warn("$progname: $File: Cannot stat file: $!\n");
    }
    return($Retval);
    # }}}
} # mod_date()

sub numdates {
    # {{{
    my $str = shift;
    my $retval;

    if ($str =~ /^$r_date-$r_date/) {
        $retval = 2;
    } elsif ($str =~ /^$r_date/) {
        $retval = 1;
    } else {
        $retval = 0;
    }
    msg(3, "numdates('$str') returns '$retval'");
    return($retval);
    # }}}
} # numdates()

sub strip_date_from_filename {
    # {{{
    my $file = shift;
    my $retval = $file;
    $retval =~ s/^20......T......*?Z\.(.*$)/$1/;
    msg(3, "strip_date_from_filename('$file') returns '$retval'");
    return($retval);
    # }}}
} # strip_date_from_filename()

sub start_date {
    # Find start of recording {{{
    my $File = shift;
    my $Retval = "";
    if ($Opt{'bwf'}) {
        my $bwf_date = bwf_date($File);
        if (length($bwf_date)) {
            $Retval = $bwf_date;
        }
    }
    D("start_date($File) returns '$Retval'");
    return($Retval);
    # }}}
} # start_date()

sub bwf_date {
    # Find start of recording in Broadcast Wave Format files {{{
    # This is based on examining .wav files from the Zoom H4n, and it 
    # seems to work there. The file format may vary on other devices.
    my $File = shift;
    my $Retval = "";
    unless (open(InFP, "<", $File)) {
        warn("$progname: $File: Cannot open file to look for BWF data: $!\n");
        return("");
    }
    my $buf;
    my $numread = read(InFP, $buf, 358);
    if ($numread != 358) {
        warn("$progname: $File: Could not read 358 bytes, but continuing: $!\n");
    }
    if ($buf =~ /^.*(\d\d\d\d)-(\d\d)-(\d\d)(\d\d):(\d\d):(\d\d)$/s) {
        $Retval = timegm($6, $5, $4, $3, $2-1, $1);
    }
    close(InFP);
    D("bwf_date($File) returns '$Retval'\n");
    return($Retval);
    # }}}
} # bwf_date()

sub sec_to_string {
    # Convert seconds since 1970 to "yyyymmddThhmmss[.frac]Z" {{{
    my ($Seconds, $Sep) = @_;
    length($Seconds) || return('');
    ($Seconds =~ /^-?(\d*)(\.\d+)?$/) || return(undef);
    my $Secfrac = ($Seconds =~ /^([\-\d]*)(\.\d+)$/) ? 1.0*$2 : "";
    $Secfrac =~ s/^0//;

    defined($Sep) || ($Sep = " ");
    my @TA = gmtime($Seconds);
    my($DateString) = sprintf("%04u%02u%02uT%02u%02u%02u%sZ",
                              $TA[5]+1900, $TA[4]+1, $TA[3],
                              $TA[2], $TA[1], $TA[0], $Secfrac);
    return($DateString);
    # }}}
} # sec_to_string()

sub print_version {
    # Print program version {{{
    print("$progname v$VERSION\n");
    # }}}
} # print_version()

sub usage {
    # Send the help message to stdout {{{
    my $Retval = shift;

    if ($Opt{'verbose'}) {
        print("\n");
        print_version();
    }
    print(<<END);

Insert filemod timestamp into filename, and start of recording if 
available. At the moment only BWF (Broadcast Wave Format, standard .wav 
with extra metadata) is supported.

Format:

  No timestamp for start of recording:
    yyyymmddThhmmssZ.OLDFILENAME
  With timestamp for start of recording:
    yyyymmddThhmmssZ-yyyymmddThhmmssZ.OLDFILENAME

Usage: $progname [options] file [files [...]]

Options:

  --bwf
    Find start of recording in Broadcast Wave Format files. This is 
    based on examining .wav files from the Zoom H4n, and it seems to 
    work there. The file format may vary on other devices.
  -d, --delete
    Delete timestamp from filename. Can not be used with -r/--replace.
  -f, --force
    If a file with the new name already exists, allow the program to 
    overwrite the file.
  -g, --git
    Use git commands when dealing with files. For example, execute the 
    command "git mv oldname newname" when renaming files.
  -n, --dry-run
    Don’t rename files, but report what would happen.
  -h, --help
    Show this help.
  -r, --replace
    Replace date in filename with new value. Can not be used with 
    -d/--delete.
  -s X, --skew X
    Adjust clock skew by adding X seconds to the timestamp. A negative 
    integer can also be specified.
  -v, --verbose
    Increase level of verbosity. Can be repeated.
  --version
    Print version information.
  --debug
    Print debugging messages.

END
    exit($Retval);
    # }}}
} # usage()

sub msg {
    # Print a status message to stderr based on verbosity level {{{
    my ($verbose_level, $Txt) = @_;

    if ($Opt{'verbose'} >= $verbose_level) {
        print(STDERR "$progname: $Txt\n");
    }
    # }}}
} # msg()

sub D {
    # Print a debugging message {{{
    $Debug || return;
    my @call_info = caller;
    chomp(my $Txt = shift);
    my $File = $call_info[1];
    $File =~ s#\\#/#g;
    $File =~ s#^.*/(.*?)$#$1#;
    print(STDERR "$File:$call_info[2] $$ $Txt\n");
    return("");
    # }}}
} # D()

__END__

# Plain Old Documentation (POD) {{{

=pod

=head1 NAME



=head1 SYNOPSIS

 [options] [file [files [...]]]

=head1 DESCRIPTION



=head1 OPTIONS

=over 4

=item B<-h>, B<--help>

Print a brief help summary.

=item B<-v>, B<--verbose>

Increase level of verbosity. Can be repeated.

=item B<--version>

Print version information.

=item B<--debug>

Print debugging messages.

=back

=head1 BUGS



=head1 AUTHOR

Made by Øyvind A. Holm S<E<lt>sunny@sunbase.orgE<gt>>.

=head1 COPYRIGHT

Copyleft © Øyvind A. Holm E<lt>sunny@sunbase.orgE<gt>
This is free software; see the file F<COPYING> for legalese stuff.

=head1 LICENCE

This program is free software: you can redistribute it and/or modify it 
under the terms of the GNU General Public License as published by the 
Free Software Foundation, either version 2 of the License, or (at your 
option) any later version.

This program is distributed in the hope that it will be useful, but 
WITHOUT ANY WARRANTY; without even the implied warranty of 
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along 
with this program.
If not, see L<http://www.gnu.org/licenses/>.

=head1 SEE ALSO

=cut

# }}}

# vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :
